C---------------------------------------------------------
C    TOOLPACK/1    Release: 3.1
C---------------------------------------------------------
C ----------------------------------------------------------------------
C
C       I S T I N   -   INclude files
C
C       This program reads in a file (presumable containing a Fortran
C       program) and produces a copy with all "include" references
C       included.  The INCLUDE statement format is the same as for
C       TIEMAC, i.e. "INCLUDE filename" where the INCLUDE begins in
C       column 1.  Source-embedded directives are produced surrounding
C       the included text, so that later tools (e.g. ISTDS) can detect
C       the fact that the text does not come from the original and
C       should not be processed.  The SEDs are:
C           *$in$ begin filename
C       and
C           *$in$ end
C
C       INCLUDE files may be nested to a maximum of MXDEEP (a parameter
C       set in subroutine PROFIL), the default being 10.
C
C       The INCLUDE files can come either from the host filestore or the
C       PFS filestore (in which case names beginning with '#' will have
C       the hash stripped off and the result looked for in the host fs).
C
C       Execution is immediately terminated if an INCLUDE file cannot be
C       found, or if the maximum nesting depth is exceeded. Other error
C       messages indicate internal errors either in the program, the
C       TIE implementation or the STRING supplementary library.
C
C       Programmed by: Malcolm Cohen, Numerical Algorithms Group,
C                      January 1986.
C
 
        PROGRAM ISTIN
 
        INTEGER IODIN,IODOUT,INPTH(81),OUTPTH(81),HFTEXT(3),
     +          PROMPT(32,3)
        LOGICAL HFILES
 
        INTEGER GETARG,OPEN,CREATE,ZGTCMD
        EXTERNAL GETARG,OPEN,CREATE,ZGTCMD,ZINIT,ZQUIT,ZMESS,ERROR
 
C "Input file: "
C "Output file: "
C "Host (H) or PFS (P) filenames: "
 
        DATA (PROMPT(I,1),I=1,13)/73,110,112,117,116,32,102,
     +105,108,101,58,32,129/,
     +       (PROMPT(I,2),I=1,14)/79,117,116,112,117,116,32,
     +102,105,108,101,58,32,129/,
     +       (PROMPT(I,3),I=1,32)/72,111,115,116,32,40,72,
     +41,32,111,114,32,80,70,83,32,40,80,
     +41,32,102,105,108,101,110,97,109,101,115,58,
     +32,129/
 
        CALL ZINIT
 
        IF (GETARG(1,INPTH,81).EQ.-100) THEN
            CALL ZPRMPT(PROMPT(1,1))
            IF (ZGTCMD(INPTH,0).EQ.-1)
     +          CALL ERROR('Couldn''t get input filename')
        END IF
        IF (GETARG(2,OUTPTH,81).EQ.-100) THEN
            CALL ZPRMPT(PROMPT(1,2))
            IF (ZGTCMD(OUTPTH,0).EQ.-1)
     +          CALL ERROR('Couldn''t get output filename')
        END IF
        IF (GETARG(3,HFTEXT,2).EQ.-100) THEN
            CALL ZPRMPT(PROMPT(1,3))
            IF (ZGTCMD(HFTEXT,0).EQ.-1)
     +          CALL ERROR('I/O ERROR READING FILE OPTIONS')
        END IF
        HFILES=HFTEXT(1).EQ.104 .OR. HFTEXT(1).EQ.72
        IF (HFTEXT(1).NE.112 .AND. HFTEXT(1).NE.80 .AND..NOT.HFILES)
     +      CALL REMARK('Warning: Assuming PFS filenames in input')
 
        IODIN=OPEN(INPTH,0)
        IF (IODIN.EQ.-1) CALL ERROR('Can''t open input file')
        IODOUT=CREATE(OUTPTH,1)
        IF (IODOUT.EQ.-1) CALL ERROR('Can''t create output file')
 
        CALL PROCES(IODIN,IODOUT,HFILES)
        CALL ZMESS('[ISTIN Normal Termination]',1)
        CALL ZQUIT(-2)
 
        END
C ----------------------------------------------------------------------
C
C       P R O C E S   -   Process file
C
 
        SUBROUTINE PROCES(INFDA,OUTFD,HFILES)
        INTEGER INFDA,OUTFD
        LOGICAL HFILES
 
        INTEGER MXDEEP
        PARAMETER (MXDEEP=10)
 
        INTEGER BUFF(134),INFD(MXDEEP),NEST,STATUS,PATTRN(16),
     +          REPLCE(15),GETFNR(3),NEWBUF(134)
 
        INTEGER GETLIN,ZSETP,ZSETR,ZPREPL,OPEN,LENGTH
        EXTERNAL GETLIN,PUTLIN,CLOSE,ZSETP,ZSETR,ZPREPL,ERROR,OPEN,
     +           LENGTH
 
C PATTRN: "%include +<?+>$"
C REPLCE: "*$in$ begin &1"
C GETFNR: "&1"
 
        DATA PATTRN/37,105,110,99,108,117,100,101,32,
     +43,60,63,43,62,36,129/,
     +       REPLCE/42,36,105,110,36,32,98,101,103,
     +105,110,32,38,49,129/,
     +       GETFNR/38,49,129/
 
        NEST=1
        INFD(1)=INFDA
        IF (ZSETP(PATTRN,.TRUE.).EQ.-1) CALL ERROR('ZSETP failed')
        IF (ZSETR(REPLCE).EQ.-1) CALL ERROR('ZSETR failed')
 
 100    STATUS=GETLIN(BUFF,INFD(NEST))
        IF (STATUS.EQ.-100) THEN
            CALL CLOSE(INFD(NEST))
            NEST=NEST-1
            IF (NEST.EQ.0) RETURN
            CALL ZMESS('*$in$ end',OUTFD)
        ELSE IF (STATUS.EQ.-1) THEN
            CALL ERROR('I/O ERROR READING FILE')
        ELSE IF (BUFF(1).EQ.105 .OR. BUFF(1).EQ.73) THEN
            IF (ZPREPL(BUFF,NEWBUF,.FALSE.).EQ.-1) THEN
                CALL ZCHOUT('Invalid INCLUDE statement: ',2)
                CALL PUTLIN(BUFF,2)
                CALL PUTLIN(BUFF,OUTFD)
            ELSE IF (NEST.EQ.MXDEEP) THEN
                CALL ZCHOUT('Error in: ',2)
                CALL PUTLIN(BUFF,2)
                CALL ERROR('INCLUDE files too deeply nested')
            ELSE
                NEST=NEST+1
                CALL PUTLIN(NEWBUF,OUTFD)
                IF (ZSETR(GETFNR).EQ.-1) CALL ERROR('ZSETR failed 2')
                IF (ZPREPL(BUFF,NEWBUF(2),.FALSE.).EQ.-1)
     +              CALL ERROR('ZPREPL failed')
                NEWBUF(LENGTH(NEWBUF))=129
                IF (HFILES) THEN
                    NEWBUF(1)=35
                    INFD(NEST)=OPEN(NEWBUF,0)
                ELSE
                    NEWBUF(1)=32
                    INFD(NEST)=OPEN(NEWBUF(2),0)
                END IF
                IF (INFD(NEST).EQ.-1) THEN
                    CALL CANT(NEWBUF)
                    CALL ERROR('Processing terminated')
                ELSE IF (ZSETR(REPLCE).EQ.-1) THEN
                    CALL ERROR('ZSETR failed 3')
                END IF
            END IF
        ELSE
            CALL PUTLIN(BUFF,OUTFD)
        END IF
        GOTO 100
 
        END
